home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gnu / adainc / a-ticoio.adb < prev    next >
Text File  |  1996-01-30  |  9KB  |  333 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --               A D A . T E X T _ I O . C O M P L E X _ I O                --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.4 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. with Ada.Text_IO;
  27.  
  28. package body Ada.Text_IO.Complex_IO is
  29.  
  30.    package F_IO is new Ada.Text_IO.Float_IO (Real);
  31.    --  Should be Real'Base, but that doesn't work in GNAT version 1.80 ???
  32.  
  33.    ---------
  34.    -- Get --
  35.    ---------
  36.  
  37.    procedure Get
  38.      (File  : in  File_Type;
  39.       Item  : out Complex;
  40.       Width : in  Field := 0)
  41.    is
  42.       Temp       : String (1 .. Width);
  43.       Length     : Natural;
  44.       Real_Item  : Real'Base;
  45.       Imag_Item  : Real'Base;
  46.       Need_Paren : Boolean := False;
  47.       A_Char     : Character;
  48.  
  49.    begin
  50.       --  General note for following code, exceptions from the calls to
  51.       --  Get for components of the complex value are propagated.
  52.  
  53.       if Width /= 0 then
  54.          Ada.Text_IO.Get_Line (File, Temp, Length);
  55.          Get (Temp (1 .. Length), Item, Length);
  56.  
  57.       --  Case of width = 0
  58.  
  59.  
  60.       else
  61.          --  Get either a real or an optional left paren
  62.          --  Needs fix for 123 (1.23,2.5) ???
  63.  
  64.          begin
  65.             F_IO.Get (File, Real_Item);
  66.  
  67.          exception
  68.             when Ada.Text_IO.Data_Error =>
  69.                Ada.Text_IO.Get (File, A_Char);
  70.  
  71.                if A_Char /= '(' then
  72.                   raise;
  73.                else
  74.                   Need_Paren := True;
  75.                   F_IO.Get (File, Real_Item);
  76.                end if;
  77.          end;
  78.  
  79.          --  Get either an imaginary part or an optional comma
  80.  
  81.          begin
  82.             F_IO.Get (File, Imag_Item);
  83.  
  84.          exception
  85.             when Ada.Text_IO.Data_Error =>
  86.  
  87.                Ada.Text_IO.Get (File, A_Char);
  88.                if A_Char /= ',' then
  89.                   raise;
  90.                else
  91.                   F_IO.Get (File, Imag_Item);
  92.                end if;
  93.          end;
  94.  
  95.          Item := (Real_Item, Imag_Item);
  96.  
  97.          while Need_Paren loop
  98.             Ada.Text_IO.Get (File, A_Char);
  99.             exit when A_Char = ')';
  100.  
  101.             if A_Char /= ' ' and A_Char /= Ascii.HT and
  102.                A_Char /= Ascii.LF then
  103.                raise Ada.Text_IO.Data_Error;
  104.             end if;
  105.  
  106.          end loop;
  107.       end if;
  108.    end Get;
  109.  
  110.    ---------
  111.    -- Get --
  112.    ---------
  113.  
  114.    procedure Get
  115.      (Item  : out Complex;
  116.       Width : in  Field := 0)
  117.    is
  118.       Temp       : String (1 .. Width);
  119.       Length     : Natural;
  120.       Real_Item  : Real'Base;
  121.       Imag_Item  : Real'Base;
  122.       Need_Paren : Boolean := False;
  123.       A_Char     : Character;
  124.  
  125.    begin
  126.       if Width /= 0 then
  127.          Ada.Text_IO.Get_Line (Temp, Length);
  128.          Get (Temp (1 .. Length), Item, Length);
  129.  
  130.       else
  131.          --  Get either a real or an optional left paren
  132.  
  133.          begin
  134.             F_IO.Get (Real_Item);
  135.  
  136.          exception
  137.             when Ada.Text_IO.Data_Error =>
  138.                Ada.Text_IO.Get (A_Char);
  139.  
  140.                if A_Char /= '(' then
  141.                   raise;
  142.                else
  143.                   Need_Paren := True;
  144.                   F_IO.Get (Real_Item);
  145.                end if;
  146.          end;
  147.  
  148.          --  Get either an imaginary part or an optional comma
  149.  
  150.          begin
  151.             F_IO.Get (Imag_Item);
  152.  
  153.          exception
  154.             when Ada.Text_IO.Data_Error =>
  155.                Ada.Text_IO.Get (A_Char);
  156.  
  157.                if A_Char /= ',' then
  158.                   raise;
  159.                else
  160.                   F_IO.Get (Imag_Item);
  161.                end if;
  162.          end;
  163.  
  164.          Item := (Real_Item, Imag_Item);
  165.  
  166.          if Need_Paren then
  167.             loop
  168.                Ada.Text_IO.Get (A_Char);
  169.                exit when A_Char = ')';
  170.  
  171.                if A_Char /= ' ' and A_Char /= Ascii.HT and
  172.                   A_Char /= Ascii.LF then
  173.                   raise Ada.Text_IO.Data_Error;
  174.                end if;
  175.             end loop;
  176.          end if;
  177.       end if;
  178.    end Get;
  179.  
  180.    ---------
  181.    -- Get --
  182.    ---------
  183.  
  184.    procedure Get
  185.      (From : in  String;
  186.       Item : out Complex;
  187.       Last : out Positive)
  188.    is
  189.       Real_Item : Real'Base;
  190.       Imag_Item : Real'Base;
  191.       Need_Paren : Boolean := False;
  192.       Pos : Positive := From'First;
  193.  
  194.    begin
  195.       while From (Pos) = ' ' or From (Pos) = Ascii.HT loop
  196.          Pos := Pos + 1;
  197.       end loop;
  198.  
  199.       if From (Pos) = '(' then
  200.          Pos := Pos + 1;
  201.          Need_Paren := True;
  202.       end if;
  203.  
  204.       F_IO.Get (From (Pos .. From'Last), Real_Item, Pos);
  205.       Pos := Pos + 1;
  206.  
  207.       while From (Pos) = ' ' or From (Pos) = Ascii.HT loop
  208.          Pos := Pos + 1;
  209.       end loop;
  210.  
  211.       if From (Pos) = ',' then
  212.          Pos := Pos + 1;
  213.       end if;
  214.  
  215.       F_IO.Get (From (Pos .. From'Last), Imag_Item, Pos);
  216.       Pos := Pos + 1;
  217.  
  218.       if Need_Paren then
  219.          while From (Pos) = ' ' or From (Pos) = Ascii.HT loop
  220.             Pos := Pos + 1;
  221.          end loop;
  222.  
  223.          if From (Pos) /= ')' then
  224.             raise Ada.Text_IO.Data_Error;
  225.          end if;
  226.       end if;
  227.  
  228.       Item := (Real_Item, Imag_Item);
  229.       Last := Pos;
  230.  
  231.    exception
  232.       when Constraint_Error =>
  233.          raise Ada.Text_IO.Data_Error;
  234.    end Get;
  235.  
  236.    ---------
  237.    -- Put --
  238.    ---------
  239.  
  240.    procedure Put
  241.      (File : in File_Type;
  242.       Item : in Complex;
  243.       Fore : in Field := Default_Fore;
  244.       Aft  : in Field := Default_Aft;
  245.       Exp  : in Field := Default_Exp)
  246.    is
  247.  
  248.    begin
  249.       Ada.Text_IO.Put (File, '(');
  250.       F_IO.Put (File, Re (Item), Fore, Aft, Exp);  -- Item.Re
  251.       Ada.Text_IO.Put (File, ',');
  252.       F_IO.Put (File, Im (Item), Fore, Aft, Exp);  -- Item.Im
  253.       Ada.Text_IO.Put (File, ')');
  254.    end Put;
  255.  
  256.    ---------
  257.    -- Put --
  258.    ---------
  259.  
  260.    procedure Put
  261.      (Item : in Complex;
  262.       Fore : in Field := Default_Fore;
  263.       Aft  : in Field := Default_Aft;
  264.       Exp  : in Field := Default_Exp)
  265.    is
  266.    begin
  267.       Ada.Text_IO.Put ('(');
  268.       F_IO.Put (Re (Item), Fore, Aft, Exp);        -- Item.Re
  269.       Ada.Text_IO.Put (',');
  270.       F_IO.Put (Im (Item), Fore, Aft, Exp);        -- Item.Im
  271.       Ada.Text_IO.Put (')');
  272.    end Put;
  273.  
  274.    ---------
  275.    -- Put --
  276.    ---------
  277.  
  278.    procedure Put
  279.      (To   : out String;
  280.       Item : in  Complex;
  281.       Aft  : in  Field := Default_Aft;
  282.       Exp  : in  Field := Default_Exp)
  283.    is
  284.       Temp : String (To'Range);       --  so we can read from it
  285.       End_Re : Positive := 1;
  286.       Start_Re : Positive := 1;
  287.  
  288.    begin
  289.       Temp (To'Last) := ')';
  290.       F_IO.Put (Temp (To'First .. To'Last - 1), Im (Item), Aft, Exp);  --  Im
  291.  
  292.       for J in To'Range loop
  293.          if Temp (J) /= ' ' then
  294.             End_Re := J - 1;
  295.             exit;
  296.          end if;
  297.       end loop;
  298.  
  299.       F_IO.Put (Temp (To'First .. End_Re), Re (Item), Aft, Exp);       --  Re
  300.  
  301.       for J in To'Range loop
  302.          if Temp (J) /= ' ' then
  303.             Start_Re := J;
  304.             exit;
  305.          end if;
  306.       end loop;
  307.  
  308.       --  Ensure enough room for paren and comma
  309.  
  310.       if Start_Re <= To'First + 1 then
  311.          raise Layout_Error;
  312.       end if;
  313.  
  314.       Temp (To'First + 1 .. To'First + (End_Re - Start_Re + 1)) :=
  315.          Temp (Start_Re .. End_Re);
  316.  
  317.       for J in To'First + (End_Re - Start_Re + 3) .. End_Re loop
  318.          Temp (J) := ' ';
  319.       end loop;
  320.  
  321.       Temp (To'First + (End_Re - Start_Re + 2)) := ',';
  322.       Temp (To'First) := '(';
  323.       To := Temp;
  324.  
  325.    exception
  326.       --  Not enough room in the string means that Layout_Error is raised
  327.  
  328.       when Constraint_Error =>
  329.          raise Layout_Error;
  330.    end Put;
  331.  
  332. end Ada.Text_IO.Complex_IO;
  333.